﻿Public Class Shikaku
    Inherits Puzzle

    Public Overrides Sub Draw()
        MyBase.Draw()
        For Each Item In Regions
            For Each Rect In Item.Rects
                DrawRect(Rect.Left, Rect.Top, Rect.Width, Rect.Height, 1)
            Next
        Next
    End Sub

    Public Overrides Sub DrawCell(ByVal e As DrawCellArgs)
        If e.Cell.g = " " Then e.Text = " "
        MyBase.DrawCell(e)
    End Sub

    Public Sub New()
        AvailableSizes = Range(5, 12)
        Size = 9
    End Sub

    Public Overrides Function OnKeyPress(ByVal Key As String) As Boolean
        Select Case Key
            Case "0" To "9"
                CursorCell.g = Trim(Val(CursorCell.g.Trim & Key))
            Case "delete"
                CursorCell.g = " "
            Case "back"
                CursorCell.g = Trim(Val(CursorCell.g.ExcludeLast(1)))
                If CursorCell.g = "0" Then CursorCell.g = " "
            Case Else
                Return MyBase.OnKeyPress(Key)
        End Select
    End Function

    Public Overrides Sub Load(ByVal Data As String)
        Size = Math.Sqrt(Len(Data) / 2)
        NewPuzzle()
        For k = 0 To Size * Size - 1
            Cells(k).g = Trim(Mid(Data, k * 2 + 1, 2))
            If Cells(k).g = "" Then Cells(k).g = " "
        Next
        Invalidate()
    End Sub

    Public Overrides Function Save() As String
        Dim Text As String = ""
        For i As Integer = 1 To Size * Size
            Text &= Left(Cells(i - 1).g & " ", 2)
        Next
        Return Text
    End Function

    Shadows Regions As New List(Of Region)

    Public Overrides Sub Solve()
        Regions.Clear()
        Regions.AddRange(From c In Cells Where Val(c.g) > 0 Select New Region(c))
        For Each Res In From r In Regions Let list = (From rect In GetRects(r.Cell)).ToList
            Res.r.Rects = Res.list
        Next
        Do
            Dim Found = False
            For Each fff In
                (From c In Cells Where c.f = "" From rg In Regions Where rg.Rects.All(Function(r) r.Contains(c.x, c.y)))
                fff.c.f = fff.rg.Cell.g
                Found = True
                Dim ffff = fff
                For Each ff In (From rg In Regions Where Not rg Is ffff.rg From r In rg.Rects Where r.Contains(ffff.c.x, ffff.c.y)).ToList
                    ff.rg.Rects.Remove(ff.r)
                Next
            Next
            If Not Found Then Exit Do
        Loop
        Invalidate()
    End Sub

    Function GetRects(ByVal Cell As Cell) As List(Of Rectangle)
        Return (
            From i In Range(1, Val(Cell.g)) Where Val(Cell.g) Mod i = 0 Let w = i, h = Val(Cell.g) / i
            From x In Range(Cell.x - w + 1, Cell.x) From y In Range(Cell.y - h + 1, Cell.y) Let r = New Rectangle(x, y, w, h)
            Where r.Left > 0 And r.Top > 0 And r.Right <= Size + 1 And r.Bottom <= Size + 1
            Where Not (From c In Cells Where Val(c.g) > 0 And Not c Is Cell And r.Contains(c.x, c.y)).Any Select r).ToList
    End Function

    Class Region

        Public Cell As Cell
        Public Rects As New List(Of Rectangle)

        Sub New(ByVal Cell As Cell)
            Me.Cell = Cell
        End Sub

    End Class

End Class

